home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / MAGICVDI.I < prev    next >
Text File  |  1991-06-08  |  32KB  |  1,336 lines
  1. (*######################################################################
  2.                                                                         
  3.   MAGIC         Modula's  All purpose  GEM  Interface  Cadre
  4.                 ¯         ¯            ¯    ¯          ¯
  5. ########################################################################
  6.  
  7.   VDI           Virtual Device Interface        Interface for Modula-2
  8.  
  9. ########################################################################
  10.   V2.02  03.04.91  Jens Pirnay          SetUserfillpattern korrigiert
  11.   V2.01  24.10.90  Peter Hellinger      Systemaufrufe jetzt in MagicSys
  12.                                         dadurch ist das Modul unabhängig
  13.   V2.00  16.10.90  Peter Hellinger      Anpassung an neues MagicSys
  14.   V1.04  05.08.90  Peter Hellinger
  15.   V1.01  18.06.90  Peter Hellinger      Bug in GDos() gefixt
  16.   V1.00  (C) by    Peter Hellinger
  17. ######################################################################*)
  18.  
  19. IMPLEMENTATION MODULE MagicVDI;
  20.  
  21. (*------------------------------*)
  22. (*       COMPILERSWITCHES       *)
  23. (*------------------------------*)
  24. (* TDI-Version:   DEAKTIVIERT   *)
  25. (*------------------------------*)
  26. (* V-  Overflow-Checks          *)
  27. (* R-  Range-Checks             *)
  28. (* S-  Stack-Check              *)
  29. (* N-  NIL-Checks               *)
  30. (* T-  TDI-Compiler vor 3.01    *)
  31. (* Q+  Branch statt Jumps       *)
  32. (*                              *)
  33. (*------------------------------*)
  34. (* MM2-Version:     AKTIVIERT   *)
  35. (*------------------------------*)
  36. (*$R-   Range-Checks            *)
  37. (*$S-   Stack-Check             *)
  38. (*                              *)
  39. (*------------------------------*)
  40.  
  41.  
  42. FROM SYSTEM     IMPORT  ADDRESS, ADR;
  43. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6, 
  44.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14, 
  45.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL, 
  46.                         sBITSET, lWORD, lINTEGER, lCARDINAL, lBITSET,
  47.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  48.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  49.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  50.                         CallGEM, CatchD0;
  51. IMPORT MagicSys;
  52.  
  53.  
  54. VAR array: POINTER TO ARRAY [0..255] OF sINTEGER;
  55.     vdipb: ADDRESS;  (* Adresse des VDI-Parameterblocks *)
  56.  
  57.  
  58. PROCEDURE VDICall (c0, c1, c3, c5, c6: sINTEGER);
  59. BEGIN
  60.  VDIControl[0]:= c0;
  61.  VDIControl[1]:= c1;
  62.  VDIControl[3]:= c3;
  63.  VDIControl[5]:= c5;
  64.  VDIControl[6]:= c6;
  65.  CallGEM (115, vdipb);
  66. END VDICall;
  67.  
  68.  
  69. PROCEDURE VqGDos(): BOOLEAN;
  70. BEGIN
  71.  RETURN MagicSys.VqGdos ();
  72. END VqGDos;
  73.  
  74.  
  75. (*#######################################################################*)
  76.  
  77.  
  78. PROCEDURE SetWritemode (handle, mode: sINTEGER): sINTEGER;
  79. BEGIN
  80.  VDIIntIn[0]:= mode;
  81.  VDICall (32, 0, 1, 0, handle);
  82.  RETURN VDIIntOut[0];
  83. END SetWritemode;
  84.  
  85.  
  86. PROCEDURE SetColor (handle, index: sINTEGER; VAR rgb: ARRAY OF LOC);
  87. BEGIN
  88.  VDIIntIn[0]:= index;
  89.  array:= ADR (rgb);
  90.  VDIIntIn[1]:= array^[0];
  91.  VDIIntIn[2]:= array^[1];
  92.  VDIIntIn[3]:= array^[2];
  93.  VDICall(14, 0, 4, 0, handle);
  94. END SetColor;
  95.  
  96.  
  97. PROCEDURE SetLinetype (handle, style: sINTEGER): sINTEGER;
  98. BEGIN
  99.  VDIIntIn[0]:= style;
  100.  VDICall (15, 0, 1, 0, handle);
  101.  RETURN VDIIntOut[0];
  102. END SetLinetype;
  103.  
  104.  
  105. PROCEDURE SetUserlinestyle (handle: sINTEGER; style: ARRAY OF LOC);
  106. BEGIN
  107.  VDIIntIn[0]:= CastToInt (style);
  108.  VDICall (113, 0, 1, 0, handle);
  109. END SetUserlinestyle;
  110.  
  111.  
  112. PROCEDURE SetLinewidth (handle, width: sINTEGER): sINTEGER;
  113. BEGIN
  114.  VDIPtsIn[0]:= width;
  115.  VDIPtsIn[1]:= 0;
  116.  VDICall (16, 1, 0, 0, handle);
  117.  RETURN VDIPtsOut[0];
  118. END SetLinewidth;
  119.  
  120.  
  121. PROCEDURE SetLinecolor (handle, color: sINTEGER): sINTEGER;
  122. BEGIN
  123.  VDIIntIn[0]:= color;
  124.  VDICall (17, 0, 1, 0, handle);
  125.  RETURN VDIIntOut[0];
  126. END SetLinecolor;
  127.  
  128.  
  129. PROCEDURE SetLineEndstyles (handle, begin, end: sINTEGER);
  130. BEGIN
  131.  VDIIntIn[0]:= begin;
  132.  VDIIntIn[1]:= end;
  133.  VDICall (108, 0, 2, 0, handle);
  134. END SetLineEndstyles;
  135.  
  136.  
  137. PROCEDURE SetMarkertype (handle, type: sINTEGER): sINTEGER;
  138. BEGIN
  139.  VDIIntIn[0]:= type;
  140.  VDICall (18, 0, 1, 0, handle);
  141.  RETURN VDIIntOut[0];
  142. END SetMarkertype;
  143.  
  144.  
  145. PROCEDURE SetMarkerheight (handle, height: sINTEGER): sINTEGER; 
  146. BEGIN
  147.  VDIPtsIn[0]:= height;
  148.  VDIPtsIn[1]:= 0;
  149.  VDICall (19, 1, 0, 0, handle);
  150.  RETURN VDIPtsOut[0];
  151. END SetMarkerheight;
  152.  
  153.  
  154. PROCEDURE SetMarkercolor (handle, index: sINTEGER): sINTEGER;
  155. BEGIN
  156.  VDIIntIn[0]:= index;
  157.  VDICall (20, 0, 1, 0, handle);
  158.  RETURN VDIIntOut[0];
  159. END SetMarkercolor;
  160.  
  161.  
  162. PROCEDURE SetCharheight (handle, hi: sINTEGER; VAR cw, ch, bw, bh: sINTEGER);
  163. BEGIN
  164.  VDIPtsIn[0]:= 0;
  165.  VDIPtsIn[1]:= hi;
  166.  VDICall (12, 1, 0, 0, handle);
  167.  cw:= VDIPtsOut[0];
  168.  ch:= VDIPtsOut[1];
  169.  bw:= VDIPtsOut[2];
  170.  bh:= VDIPtsOut[3];
  171. END SetCharheight;
  172.  
  173.  
  174. PROCEDURE SetCharpoints (handle, hi: sINTEGER; VAR cw, ch, bw, bh: sINTEGER): sINTEGER;
  175. BEGIN
  176.  VDIIntIn[0]:= hi;
  177.  VDICall (107, 0, 1, 0, handle);
  178.  cw:= VDIPtsOut[0];
  179.  ch:= VDIPtsOut[1];
  180.  bw:= VDIPtsOut[2];
  181.  bh:= VDIPtsOut[3];
  182.  RETURN VDIIntOut[0];
  183. END SetCharpoints;
  184.  
  185.  
  186. PROCEDURE SetCharbaseline (handle, angle: sINTEGER): sINTEGER;
  187. BEGIN
  188.  VDIIntIn[0]:= angle;
  189.  VDICall (13, 0, 1, 0, handle);
  190.  RETURN VDIIntOut[0];
  191. END SetCharbaseline;
  192.  
  193.  
  194. PROCEDURE SetTextface (handle, font: sINTEGER): sINTEGER;
  195. BEGIN
  196.  VDIIntIn[0]:= font;
  197.  VDICall (21, 0, 1, 0, handle);
  198.  RETURN VDIIntOut[0];
  199. END SetTextface;
  200.  
  201.  
  202. PROCEDURE SetTextcolor (handle, index: sINTEGER): sINTEGER;
  203. BEGIN
  204.  VDIIntIn[0]:= index;
  205.  VDICall (22, 0, 1, 0, handle);
  206.  RETURN VDIIntOut[0];
  207. END SetTextcolor;
  208.  
  209.  
  210. PROCEDURE SetTexteffect (handle: sINTEGER; effect: sBITSET): sBITSET;
  211. BEGIN
  212.  VDIIntIn[0]:= CastToInt (effect);
  213.  VDICall (106, 0, 1, 0, handle);
  214.  RETURN CastToBitset (VDIIntOut[0]);
  215. END SetTexteffect;
  216.  
  217.  
  218. PROCEDURE SetTextalignment (handle, hin, vin: sINTEGER; VAR ho, vo: sINTEGER);
  219. BEGIN
  220.  VDIIntIn[0]:= hin;
  221.  VDIIntIn[1]:= vin;
  222.  VDICall (39, 0, 2, 0, handle);
  223.  ho:= VDIIntOut[0];
  224.  vo:= VDIIntOut[1];
  225. END SetTextalignment;
  226.  
  227.  
  228. PROCEDURE SetFillinterior (handle, index: sINTEGER): sINTEGER;
  229. BEGIN
  230.  VDIIntIn[0]:= index;
  231.  VDICall (23, 0, 1, 0, handle);
  232.  RETURN VDIIntOut[0];
  233. END SetFillinterior;
  234.  
  235.  
  236. PROCEDURE SetFillstyle (handle, style: sINTEGER): sINTEGER;
  237. BEGIN
  238.  VDIIntIn[0]:= style;
  239.  VDICall (24, 0, 1, 0, handle);
  240.  RETURN VDIIntOut[0];
  241. END SetFillstyle;
  242.  
  243.  
  244. PROCEDURE SetFillcolor (handle, index: sINTEGER): sINTEGER; 
  245. BEGIN
  246.  VDIIntIn[0]:= index;
  247.  VDICall (25, 0, 1, 0, handle);
  248.  RETURN VDIIntOut[0];
  249. END SetFillcolor;
  250.  
  251.  
  252. PROCEDURE SetFillperimeter (handle: sINTEGER; border: BOOLEAN): BOOLEAN;
  253. BEGIN
  254.  IF border THEN  VDIIntIn[0]:= 1;  ELSE  VDIIntIn[0]:= 0;  END;
  255.  VDICall (104, 0, 1, 0, handle);
  256.  RETURN VDIIntOut[0] = 1;
  257. END SetFillperimeter;
  258.  
  259.  
  260. PROCEDURE SetUserfillpattern (handle: sINTEGER; VAR pat: ARRAY OF LOC);
  261. VAR old: ADDRESS;
  262. BEGIN
  263.  old:= VDIPB.intin;
  264.  VDIPB.intin:= ADR (pat);
  265. (** Alter Aufruf: damit ging aber alles schief...
  266.  VDICall (112, 0, HIGH(pat) * 16, 0, handle);
  267. **) 
  268.  VDICall (112, 0, HIGH(pat), 0, handle);
  269.  VDIPB.intin:= old;
  270. END SetUserfillpattern;
  271.  
  272.  
  273. (*#######################################################################*)
  274.  
  275.  
  276. PROCEDURE OpenWorkstation (VAR in: ARRAY OF LOC; VAR handle: sINTEGER;
  277.                            VAR out: ARRAY OF LOC);
  278. VAR c: sINTEGER;
  279. BEGIN
  280.  array:= ADR (in);
  281.  FOR c:= 0 TO 10 DO  VDIIntIn[c]:= array^[c]; END;
  282.  VDICall(1, 0, 11, 0, handle);
  283.  handle:= VDIControl[6];
  284.  array:= ADR (out);
  285.  FOR c:= 0 TO 44 DO  array^[c]:= VDIIntOut[c]; END;
  286.  FOR c:= 0 TO 11 DO  array^[c+44]:= VDIPtsOut[c]; END;
  287. END OpenWorkstation;
  288.  
  289.  
  290. PROCEDURE CloseWorkstation (handle: sINTEGER);
  291. BEGIN
  292.  VDICall(2, 0, 0, 0, handle);
  293. END CloseWorkstation;
  294.  
  295.  
  296. PROCEDURE OpenVirtual (VAR in: ARRAY OF LOC; VAR handle: sINTEGER;
  297.                        VAR out: ARRAY OF LOC);
  298. VAR c: sINTEGER;
  299. BEGIN
  300.  array:= ADR (in);
  301.  FOR c:= 0 TO 10 DO  VDIIntIn[c]:= array^[c]; END;
  302.  VDICall(100, 0, 11, 0, handle);
  303.  handle:= VDIControl[6];
  304.  array:= ADR (out);